home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / 3DGame-Shan.st next >
Text File  |  1993-07-24  |  12KB  |  491 lines
  1. DisplayObject subclass: #ThreeDBall
  2.     instanceVariableNames: 'x y z xi yi screenOffset env form backgroundForm '
  3.     classVariableNames: 'BallImagesDict '
  4.     poolDictionaries: ''
  5.     category: '3DGame-Shan'!
  6. ThreeDBall comment:
  7. 'The original prototype of ThreeDBall is a subclass of IconicMode.  The prototype was built within a day and running correctly.  For performance reason, it was rewritten.  Now it is not a mode anymore.  Notice that the example is to show the concurrent input ability of the MMS.  Also ThreeDBall does not conduct a dialogue with the user.  It is reasonable for it to not be a mode.  Shan June 2, 1989'!
  8.  
  9.  
  10. !ThreeDBall methodsFor: 'initialize'!
  11.  
  12. initialize
  13.     x _ 0.
  14.     y _ 0.    
  15.     z _ 0.
  16.     form _ BallImagesDict at: 50! !
  17.  
  18. !ThreeDBall methodsFor: 'positioning'!
  19.  
  20. moveToX: x1 y: y1 z: z1 
  21.     "Take the object spece coordinates and compute the image space xi   
  22.     and yi.  Shan June 1, 1989"
  23.  
  24.     | ballSize dObjConts newForm scaleFactor |
  25.     x _ x1.
  26.     y _ y1.
  27.     z _ z1.
  28.     backgroundForm isNil
  29.         ifTrue: 
  30.             [backgroundForm _ self backgroundAt: self screenOffset + (300 @ 300)].
  31.     scaleFactor _ 200 / (200 + z).
  32.     ballSize _ (50 * scaleFactor) rounded.
  33.     newForm _ BallImagesDict at: ballSize.
  34.     form ~~ newForm ifTrue: [form _ newForm].
  35.     xi _ (x * scaleFactor) rounded + 350 - ballSize + self screenOffset x.
  36.     yi _ (y * scaleFactor) rounded + 350 - ballSize + self screenOffset y.
  37.     self moveTo: xi @ yi restoring: backgroundForm!
  38.  
  39. moveXTo: x1 y: y1
  40.     self moveToX: x1 y: y1 z: z!
  41.  
  42. moveZTo: z1
  43.     self moveToX: x y: y z: z1!
  44.  
  45. refreshBackground
  46.     backgroundForm _ self backgroundAt: backgroundForm offset! !
  47.  
  48. !ThreeDBall methodsFor: 'access'!
  49.  
  50. env: e
  51.     env _ e!
  52.  
  53. extent
  54.     ^101 @ 101!
  55.  
  56. screenOffset
  57.     screenOffset isNil
  58.         ifTrue: [^screenOffset _ env mode unclippedDisplayBox origin]
  59.         ifFalse: [^screenOffset]!
  60.  
  61. x
  62.     ^x!
  63.  
  64. xi
  65.     ^xi!
  66.  
  67. y
  68.     ^y!
  69.  
  70. yi
  71.     ^yi!
  72.  
  73. z
  74.     ^z! !
  75.  
  76. !ThreeDBall methodsFor: 'displaying'!
  77.  
  78. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
  79.     "Shan June 2, 1989"
  80.  
  81.     form
  82.         displayOn: aDisplayMedium
  83.         at: aDisplayPoint
  84.         clippingBox: clipRectangle
  85.         rule: ruleInteger
  86.         mask: aForm!
  87.  
  88. erase
  89.     backgroundForm display!
  90.  
  91. paint
  92.     form displayAt: xi@yi! !
  93. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  94.  
  95. ThreeDBall class
  96.     instanceVariableNames: ''!
  97.  
  98.  
  99. !ThreeDBall class methodsFor: 'class initialize'!
  100.  
  101. initBallImagesDict
  102.     "When space is a problem we may not want all these forms stay with 
  103.      the image.  This method can be called whenever the 3D game is  
  104.     launched and the releaseBallImagesDict is called when the program 
  105.     finishes running.  Shan June 1, 1989"
  106.     "ThreeDBall initBallImagesDict"
  107.  
  108.     | aCircle aForm |
  109.     BallImagesDict _ Dictionary new: 50.
  110.     aCircle _ Circle new.
  111.     aCircle form: (Form extent: 1 @ 1) black.
  112.     12 to: 50 do: 
  113.         [:n | 
  114.         aForm _ Form extent: (2 * n+1) @ ((2 * n) +1).
  115.         aCircle radius: n.
  116.         aCircle center: n @ n.
  117.         aCircle displayOn: aForm.
  118.         aForm convexShapeFill: Form black.
  119.         BallImagesDict at: n put: ("MMS"OpaqueForm shape: aForm)]!
  120.  
  121. initialize
  122.     "If space is a problem, this initialize method should be commented out.  
  123.     Shan June 1, 1989"
  124.     "ThreeDBall initialize"
  125.  
  126.     ThreeDBall initBallImagesDict!
  127.  
  128. releaseBallImagesDict
  129.     "Shan June 1, 1989"
  130.     "ThreeDBall releaseBallImagesDict"
  131.  
  132.     BallImagesDict _ nil! !
  133.  
  134. !ThreeDBall class methodsFor: 'instance creation'!
  135.  
  136. new
  137.     ^ super new initialize! !
  138.  
  139. ThreeDBall initialize!
  140.  
  141.  
  142. ThreeDBall subclass: #ThreeDQuestBall
  143.     instanceVariableNames: 'running vx vy vz '
  144.     classVariableNames: ''
  145.     poolDictionaries: ''
  146.     category: '3DGame-Shan'!
  147.  
  148.  
  149. !ThreeDQuestBall methodsFor: 'start-stop'!
  150.  
  151. running 
  152.     ^running!
  153.  
  154. start
  155.     "Start the moving loop.  Fork a process that updates the position just 
  156.     like the CrystalQuest except it's 3D.  Shan June3, 1989"
  157.  
  158.     | delay |
  159.     delay _ Delay forMilliseconds: 20.
  160.     running _ true.
  161.     [[running]
  162.         whileTrue: 
  163.             [self updatePosition.
  164.             delay wait]] fork!
  165.  
  166. stop
  167.     running _ false! !
  168.  
  169. !ThreeDQuestBall methodsFor: 'initialize'!
  170.  
  171. initialize
  172.     super initialize.
  173.     running _ false.
  174.     vx _ vy _ vz _ 0! !
  175.  
  176. !ThreeDQuestBall methodsFor: 'access'!
  177.  
  178. acclX: ax y: ay
  179.     self acclX: ax y: ay z: 0!
  180.  
  181. acclX: ax y: ay z: az
  182.     | newVx newVy newVz |
  183.     running ifFalse: [self start].
  184.     newVx _ vx + ax.
  185.     newVy _ vy + ay.
  186.     newVz _ vz + az.
  187.     "Boundary check."
  188.     newVx > 6 ifTrue: [ newVx _ 6].
  189.     newVx < -6 ifTrue: [ newVx _ -6].
  190.     newVy > 6 ifTrue: [ newVy _ 6].
  191.     newVy < -6 ifTrue: [ newVy _ -6].
  192.     newVz > 6 ifTrue: [ newVz _ 6].
  193.     newVz < -6 ifTrue: [ newVz _ -6].
  194.     "Update the velocity"
  195.     vx _ newVx. vy_ newVy.  vz _newVz!
  196.  
  197. acclZ: az
  198.     self acclX: 0 y: 0 z: az! !
  199.  
  200. !ThreeDQuestBall methodsFor: 'positioning'!
  201.  
  202. updatePosition
  203.     "Compute the next position and move self there.  Shan June 3, 1989"
  204.     | newX newY newZ |
  205.     newX _ x + vx.
  206.     newY _ y + vy.
  207.     newZ _ z + vz.
  208.     "Boundary check."
  209.     newX > 300 ifTrue: [newX _ 300].
  210.     newX < -300 ifTrue: [newX _ -300].
  211.     newY > 300 ifTrue: [newY _ 300].
  212.     newY < -300 ifTrue: [newY _ -300].    
  213.     newZ < 0 ifTrue: [newZ _ 0. vz _ 0].
  214.     newZ > 600 ifTrue: [newZ _ 600. vz _ 0].
  215.     self moveToX: newX y: newY z: newZ.
  216.     "See if there is a hil"
  217.     env checkHitX: x y: y z: z! !
  218.  
  219. SemanticObject subclass: #ThreeDEnv
  220.     instanceVariableNames: 'modifyingXY ball moveZBuffer '
  221.     classVariableNames: ''
  222.     poolDictionaries: ''
  223.     category: '3DGame-Shan'!
  224.  
  225.  
  226. !ThreeDEnv methodsFor: 'controller-msg'!
  227.  
  228. moveXY: e 
  229.     | x y delta newX newY |
  230.     modifyingXY ifFalse: [^self].
  231.     delta _ e origin - e previousOrigin.
  232.     newX _ ball x + delta x.
  233.     newY _ ball y + delta y.
  234.     newX > 300 ifTrue: [newX _ 300].
  235.     newX < -300 ifTrue: [newX _ -300].
  236.     newY > 300 ifTrue: [newY _ 300].
  237.     newY < -300 ifTrue: [newY _ -300].
  238.     ball moveXTo: newX y: newY!
  239.  
  240. moveZ: e 
  241.     | delta newZ |
  242.     e keyboardEvent keyCharacter = $r
  243.         ifTrue: ["Move forward.  Shan June 1, 1989"
  244.             delta _ 4]
  245.         ifFalse: [e keyboardEvent keyCharacter = $f
  246.                 ifTrue: [delta _ -4]
  247.                 ifFalse: [^self]].
  248.     "This is added to compressed the z changes.  Shan June 2, 1989"
  249.     moveZBuffer _ moveZBuffer + delta.
  250.     (moveZBuffer >= 12 or: [moveZBuffer <= -12])
  251.         ifTrue: 
  252.             [newZ _ ball z + moveZBuffer.
  253.             moveZBuffer _ 0.
  254.             newZ < 0 ifTrue: [newZ _ 0].
  255.             newZ > 600 ifTrue: [newZ _ 600].
  256.             ball moveZTo: newZ]!
  257.  
  258. toggleModifyXY: e 
  259.     modifyingXY _ modifyingXY not.
  260.     modifyingXY
  261.         ifTrue: [Cursor blank show]
  262.         ifFalse: [Cursor normal show]! !
  263.  
  264. !ThreeDEnv methodsFor: 'access'!
  265.  
  266. ball: b
  267.     ball _ b.
  268.     ball env: self.! !
  269.  
  270. !ThreeDEnv methodsFor: 'initialize-release'!
  271.  
  272. initialize
  273.     super initialize.
  274.     moveZBuffer _ 0.
  275.     modifyingXY _ false.
  276.     self initMovingBall!
  277.  
  278. initMovingBall
  279.     self ball: ThreeDBall new! !
  280.  
  281. !ThreeDEnv methodsFor: 'MMS-initializations'!
  282.  
  283. setUpAppearance
  284.     "Shan June 9, 1989"
  285.  
  286.         | z startX endX y scaleFactor |
  287.     super setUpAppearance.  "Shan July 21, 1989"
  288.     mode displayObject absAdd: (MMSLine from: 0 @ 0 to: 261 @ 261
  289.             width: 1 color: Form black).
  290.     mode displayObject absAdd: (MMSLine from: 438 @ 438 to: 700 @ 700
  291.             width: 1 color: Form black).
  292.     mode displayObject absAdd: (MMSLine from: 0 @ 700 to: 261 @ 438
  293.             width: 1 color: Form black).
  294.     mode displayObject absAdd: (MMSLine from: 700 @ 0 to: 438 @ 261
  295.             width: 1 color: Form black).
  296.     mode displayObject absAdd: (MMSLine from: 261 @ 261 to: 438 @ 261
  297.             width: 1 color: Form black).
  298.     mode displayObject absAdd: (MMSLine from: 261 @ 261 to: 261 @ 438
  299.             width: 1 color: Form black).
  300.     mode displayObject absAdd: (MMSLine from: 261 @ 438 to: 438 @ 438
  301.             width: 1 color: Form black).
  302.     mode displayObject absAdd: (MMSLine from: 438 @ 261 to: 438 @ 438
  303.             width: 1 color: Form black).
  304.     1 to: 9 do: [:n | "Draw the ground lines"
  305.         z _ n * 50.
  306.         scaleFactor _ 200 / (200 + z).
  307.         startX _ (-295 * scaleFactor) rounded + 348.
  308.         endX _ (295 * scaleFactor) rounded + 350.
  309.         y _ (300 * scaleFactor) rounded + 350.
  310.         mode displayObject absAdd: (MMSLine from: startX @ y to: endX @ y
  311.             width: 1 color: Form black)].    
  312.     mode displayObject makeAbsoluteFaster!
  313.  
  314. setUpController
  315.     "Shan June 9, 1989"
  316.  
  317.     | ctrl erDict |
  318.     ctrl _ MController new.
  319.     erDict _ ctrl eventResponses deepCopy.
  320.     erDict at: #cursorMove put: #moveXY:.
  321.     erDict at: #leftButtonDown put: #toggleModifyXY:.
  322.     erDict at: #keyboardEvent put: #moveZ:.
  323.     erDict at: #keyboardUp put: #moveZ:.
  324.     ctrl eventResponses: erDict.
  325.     mode controller: ctrl!
  326.  
  327. setUpMode
  328.     "Shan June 9, 1989"
  329.  
  330.     mode _ RootMode new minimumSize: 702 @ 702.
  331.     mode label: '3D Moving Game'.
  332.     mode semanticObject: self! !
  333. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  334.  
  335. ThreeDEnv class
  336.     instanceVariableNames: ''!
  337.  
  338.  
  339. !ThreeDEnv class methodsFor: 'examples'!
  340.  
  341. newStart3D
  342.     "ThreeDEnv newStart3D"
  343.     "Shan June 9, 1989"
  344.  
  345.     ThreeDEnv new mode startUp! !
  346.  
  347. ThreeDEnv subclass: #ThreeDQuestEnv
  348.     instanceVariableNames: 'targets '
  349.     classVariableNames: 'ThreeDQuestEnvMiddleButtonMenu '
  350.     poolDictionaries: ''
  351.     category: '3DGame-Shan'!
  352.  
  353.  
  354. !ThreeDQuestEnv methodsFor: 'initialize-release'!
  355.  
  356. initialize
  357.     super initialize.
  358.     targets _ OrderedCollection new!
  359.  
  360. initMovingBall
  361.     self ball: ThreeDQuestBall new!
  362.  
  363. release
  364.     ball stop.
  365.     Cursor normal show.
  366.     super release! !
  367.  
  368. !ThreeDQuestEnv methodsFor: 'targets'!
  369.  
  370. addTargetBallAtX: x1 y: y1 z: z1 
  371.     | targetball |
  372.     targetball _ ThreeDBall new.
  373.     targetball env: self.
  374.     targetball
  375.         moveToX: x1
  376.         y: y1
  377.         z: z1.
  378.     targets add: targetball!
  379.  
  380. addTargets
  381.     |x1 y1 z1 rand|
  382.     rand _ Random new.
  383.     3 timesRepeat: [
  384.     x1 _ (rand next * 600) rounded - 300.
  385.     y1 _ (rand next * 600) rounded - 300.
  386.     z1 _ (rand next * 600) rounded.
  387.     self addTargetBallAtX: x1 y: y1 z: z1]!
  388.  
  389. checkHitX: x y: y z: z 
  390.     "Shan September 30, 1989"
  391.  
  392.     | temp |
  393.     temp _ targets copy.
  394.     targets do: [:each | ((each x - x) abs < 30 and: [(each y - y) abs < 30 and: [(each z - z) abs < 30]])
  395.             ifTrue: 
  396.                 [temp remove: each.
  397.                 mode display.
  398.                 temp do: [:tball | tball paint].
  399.                 ball refreshBackground]].
  400.     targets _ temp! !
  401.  
  402. !ThreeDQuestEnv methodsFor: 'controller-msg'!
  403.  
  404. moveXY: e 
  405.     | x y delta ax ay |
  406.     modifyingXY ifFalse: [^self].
  407.     delta _ e origin - e previousOrigin.
  408.     ax _ (delta x / 5) rounded.
  409.     ay _ (delta y / 5) rounded.
  410.     ball acclX: ax y: ay!
  411.  
  412. moveZ: e 
  413.     | delta newZa | 
  414.     e keyboardEvent keyCharacter = $r
  415.         ifTrue: ["Move forward.  Shan June 1, 1989"
  416.             delta _ 1]
  417.         ifFalse: [e keyboardEvent keyCharacter = $f
  418.                 ifTrue: [delta _ -1]
  419.                 ifFalse: [^self]].
  420.     "This is added to compressed the z changes.  Shan June 2, 1989"
  421.     moveZBuffer _ moveZBuffer + delta.
  422.     (moveZBuffer >= 1 or: [moveZBuffer <= -1])
  423.         ifTrue: 
  424.             [ball acclZ: moveZBuffer.
  425.             moveZBuffer _ 0]! !
  426.  
  427. !ThreeDQuestEnv methodsFor: 'menu access'!
  428.  
  429. middleButtonMenu
  430.     "Shan October 21, 1989"
  431.     ThreeDQuestEnvMiddleButtonMenu isNil ifTrue: [^ThreeDQuestEnvMiddleButtonMenu _ ActionMenu
  432.         labels: 'New Game\More Balls' withCRs
  433.         lines: #()
  434.         selectors: #(startNewGame  moreBalls  )].
  435.     ^ThreeDQuestEnvMiddleButtonMenu! !
  436.  
  437. !ThreeDQuestEnv methodsFor: 'menu support'!
  438.  
  439. moreBalls
  440.     "Shan October 21, 1989"
  441.     ball running ifTrue: [ball erase].
  442.     self addTargets.
  443.     ball running ifTrue: [ball refreshBackground]!
  444.  
  445. startNewGame
  446.     "Shan October 21, 1989" 
  447.     mode display.
  448.     targets _ OrderedCollection new.
  449.     self addTargets.
  450.     ball running ifTrue: [ball refreshBackground]! !
  451.  
  452. !ThreeDQuestEnv methodsFor: 'MMS-initializations'!
  453.  
  454. setUpController
  455.     "Shan June 9, 1989"
  456.  
  457.     | ctrl erDict |
  458.     super setUpController.
  459.     ctrl _ mode controller.
  460.     erDict _ ctrl eventResponses deepCopy.
  461.     erDict at: #middleButtonDown put: #expandMiddleMenu.
  462.     ctrl eventResponses: erDict.
  463.     mode controller: ctrl! !
  464. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  465.  
  466. ThreeDQuestEnv class
  467.     instanceVariableNames: ''!
  468.  
  469.  
  470. !ThreeDQuestEnv class methodsFor: 'examples'!
  471.  
  472. newStart3DQuest
  473.     "ThreeDQuestEnv newStart3DQuest"
  474.     "Shan June 9, 1989"
  475.  
  476.     ThreeDQuestEnv new mode startUp! !
  477.  
  478. !ThreeDQuestEnv class methodsFor: 'memory management stuff'!
  479.  
  480. private
  481.     "These messages are used to check the freeing of the memory.  Shan 
  482.     June 4, 1989"
  483.     "ThreeDQuestEnv allInstances do: [: each | each nilFields] 
  484.     ThreeDBall allInstances do: [: each | each nilFields]. 
  485.     ThreeDQuestBall allInstances  do: [: each | each stop] 
  486.     MMSController1 allInstances  do: [: each | each nilFields] 
  487.     RootMode allInstances  do: [: each | Smalltalk quickPointersTo: each 
  488.     do: [:pt| pt _ nil]] 
  489.     IconicMode allInstances  do: [: each | each breakDependents]"
  490.  
  491.     ^self! !